home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / examples / avi < prev    next >
Encoding:
Text File  |  2000-08-24  |  9.7 KB  |  285 lines
  1. #!/usr/app/bin/perl
  2.  
  3. eval 'exec /usr/app/bin/perl  -S $0 ${1+"$@"}'
  4.     if 0; # not running under some shell
  5. # pcg@goof.com
  6. # a simpleminded uncompressed avi load/save plug-in
  7.  
  8. use Gimp 1.14;
  9. use Gimp::Fu;
  10. use Gimp::UI;
  11. use Fcntl;
  12.  
  13. # Gimp::set_trace(TRACE_ALL);
  14.  
  15. # start a hunk
  16. sub push_hunk($) {
  17.    print FILE $_[0], "\xff\xff\xff\xff";
  18.    push @hunks, tell FILE;
  19. }
  20.  
  21. # fixup latest hunk
  22. sub pop_hunk {
  23.    my $end = tell FILE;
  24.    my $len = pop @hunks;
  25.    seek FILE,$len-4,0;
  26.    print FILE pack "V", $end-$len;
  27.    seek FILE,$end,0;
  28. }
  29.  
  30. register "file_avi_save",
  31.          "save image as uncompressed avi",
  32.          "Saves images in the 24 bit uncompressed AVI format used by windows software",
  33.          "Marc Lehmann",
  34.          "Marc Lehmann <pcg\@goof.com>",
  35.          "1999-11-08",
  36.          "<Save>/AVI",
  37.          "RGB",
  38.          [
  39.           [PF_RADIO,    "depth",    "format (currently always 0)", 24, ["24bpp" => 24, "15bpp" => 15]],
  40.           [PF_RADIO,    "compression",    "compression (currently always 0)", 0, [none => 0]],
  41.           [PF_BOOL,    "index",    "write an index hunk (required by some software)", 1],
  42.          ],
  43.          sub {
  44.    my($img,$drawable,$filename,$raw_filename,$depth,$compression,$index) = @_;
  45.    my($new_img,$new_drawable);
  46.    my $export = Gimp::UI::export_image($new_img=$img, $new_drawable=$drawable, "AVI",
  47.                                        EXPORT_CAN_HANDLE_RGB|EXPORT_CAN_HANDLE_LAYERS_AS_ANIMATION|EXPORT_CAN_HANDLE_ALPHA );
  48.    die "export failed" if $export == EXPORT_CANCEL;
  49.    sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die "Unable to open '$filename' for writing: $!\n";
  50.    my $us_frame = eval { $img->parasite_find("gimp-interframe-delay")->data } || 100000;
  51.    #Gimp->tile_cache_ntiles($img->width / Gimp->tile_width + 3); coredumps!
  52.  
  53.    my ($width, $height) = ($img->width, $img->height);
  54.    my @layers = $new_img->get_layers;
  55.    for (@layers) {
  56.       die "all layers must have the same size as the image\n" if $width != $_->width or $height != $_->height;
  57.    }
  58.  
  59.    $depth = 16 if $depth == 15;
  60.  
  61.    $new_img->selection_all;
  62.    my $framesize = ($width*$height*$depth) >> 3;
  63.  
  64.    my $idx1;
  65.  
  66.    init Progress "Saving '$filename' as AVI...";
  67.  
  68.    push_hunk "RIFF"; print FILE "AVI ";
  69.       push_hunk "LIST"; print FILE "hdrl";
  70.          push_hunk "avih";
  71.             print FILE pack "V*",
  72.                             $us_frame,
  73.                             $framesize*1_000_000/$us_frame,
  74.                             0,
  75.                             0x00000810,  # only a god may know why...
  76.                             scalar@layers,
  77.                             0,
  78.                             1,
  79.                             $framesize,
  80.                             $width,
  81.                             $height,
  82.                             0,
  83.                             0,
  84.                             0,
  85.                             0;
  86.          pop_hunk;
  87.          push_hunk "LIST"; print FILE "strl";
  88.             push_hunk "strh";
  89.                print FILE pack "A4 V11 V2",
  90.                                "vids",
  91.                                0,
  92.                                0,
  93.                                0,
  94.                                0,
  95.                                $us_frame,
  96.                                1_000_000,
  97.                                0,
  98.                                scalar@layers,
  99.                                $framesize,
  100.                                0,
  101.                                0,
  102.                                 
  103.                                0,
  104.                                0;
  105.             pop_hunk;
  106.             push_hunk "strf";
  107.                print FILE pack "V3 v2 V6",
  108.                                40, # ??
  109.                                $width,
  110.                                $height,
  111.                                1,
  112.                                $depth,
  113.                                0,
  114.                                $framesize,
  115.                                0,
  116.                                0,
  117.                                0,
  118.                                0;
  119.             pop_hunk;
  120.          pop_hunk;
  121.       pop_hunk;
  122.       push_hunk "LIST"; print FILE "movi";
  123.          for (0..$#layers) {
  124.             my $r = new PixelRgn $layers[-1-$_],0,0,$width,$height,0,0;
  125.             my $d = $r->get_rect2(0,0,$width,$height);
  126.             Gimp::RAW::convert_32_24_inplace $d if $r->bpp == 4;
  127.             Gimp::RAW::reverse_v_inplace $d, $width*3;
  128.             Gimp::RAW::convert_bgr_rgb_inplace $d if $depth == 24;
  129.             Gimp::RAW::convert_24_15_inplace $d if $depth == 16;
  130.  
  131.             $idx1 .= "00db" . pack "V*", 16, tell FILE, $framesize if $index;
  132.  
  133.             print FILE "00db",
  134.                        (pack "V", $framesize),
  135.                        $d;
  136.  
  137.             update Progress $_ / @layers;
  138.          }
  139.       pop_hunk;
  140.       if ($index) {
  141.          push_hunk "idx1";
  142.             print FILE $idx1;
  143.          pop_hunk;
  144.       }
  145.    pop_hunk;
  146.    close FILE;
  147.    $new_img->delete if $export == EXPORT_EXPORT;
  148.    ();
  149. };
  150.  
  151. # a generic iff/riff parser. LIST's are simply flattened out,
  152. # JUNK is just skipped. 
  153. sub parse_iff {
  154.    my $size = shift;
  155.    my $default = pop;
  156.    my %action = @_;
  157.    my($hunk,$len);
  158.    while ($size > 0) {
  159.       read FILE,$hunk,4; $size -= 4;
  160.       $size >= 4 or die "AVI hunk $hunk ends unexpectedly\n";
  161.       read FILE,$len,4; $size -= 4;
  162.       $len = unpack "V", $len;
  163.       $size >= $len or Gimp->message("WARNING: broken avi, hunk '$hunk' too long ($size < $len)");
  164.       $size -= $len;
  165.       if ($hunk eq "LIST") {
  166.          read FILE,$hunk,4;
  167.          parse_iff ($len-4, %action, $default);
  168.       } elsif ($hunk eq "JUNK") {
  169.          seek FILE,$len,1;
  170.       } elsif ($action{$hunk}) {
  171.          $action{$hunk}->($len);
  172.       } else {
  173.          $default->($hunk,$len);
  174.       }
  175.    }
  176. }
  177.  
  178. sub skip_hunk {
  179.    seek FILE,$_[0],1;
  180. }
  181.  
  182. register "file_avi_load",
  183.          "load uncompressed avi movie",
  184.          "Loads images that were saved in 15/24 bit uncompressed RGB AVI format used mainly by windows",
  185.          "Marc Lehmann",
  186.          "Marc Lehmann <pcg\@goof.com>",
  187.          "1999-11-08",
  188.          "<Load>/AVI",
  189.          undef,
  190.          [],
  191.          sub {
  192.    my($filename) = @_;
  193.    sysopen FILE,$filename,O_RDONLY or die "Unable to open '$filename' for reading: $!\n";
  194.    my $image;
  195.    my $comment;
  196.  
  197.    seek FILE, 0, 2; my $filesize = tell FILE; seek FILE, 0, 0;
  198.    init Progress "Loading AVI image from '$filename'...";
  199.  
  200.    $filesize > 12 or die "File too small to be an AVI\n";
  201.    read FILE,$comment,4; $filesize -= 4;
  202.    die "File is not a RIFF file\n" unless $comment eq "RIFF";
  203.    read FILE,$comment,4; $filesize -= 4;
  204.    $comment = unpack "V", $comment;
  205.    die "RIFF hunk too short\n" unless $comment <= $filesize;
  206.    $filesize = $comment;
  207.    read FILE,$comment,4;
  208.    die "RIFF file is not an AVI\n" unless $comment eq "AVI ";
  209.  
  210.    my $frame = 0;
  211.    my ($us_frame,$frames,$width,$height);
  212.    my $type;
  213.    my ($size,$planes,$depth,$compression,$image_size);
  214.  
  215.    parse_iff ($filesize-4,
  216.       "avih" => sub {
  217.          read FILE,$comment,$_[0];
  218.          die "avih header too short\n" unless $_[0] >= 14*4;
  219.          ($us_frame,undef,undef,undef,$frames,undef,undef,undef,$width,$height)
  220.             = unpack "V10", $comment;
  221.       },
  222.       "strh" => sub {
  223.          read FILE,$comment,$_[0];
  224.          die "strh header too short\n" unless $_[0] >= 4;
  225.          ($type)
  226.             = unpack "A4", $comment;
  227.       },
  228.       "strf" => sub {
  229.          read FILE,$comment,$_[0];
  230.          if ($type eq "vids") {
  231.             die "strh(vids)/strf header too short\n" unless $_[0] >= 7*4;
  232.             ($size,$width,$height,$planes,$depth,$compression,$image_size)
  233.                = unpack "V3 v2 V3", $comment;
  234.             $depth == 24 or $depth == 16 or die "unsupported bit depth $depth (only 15/24 bit supported)\n";
  235.             $compression == 0 or die "compressed streams not supported\n";
  236.             $planes == 1 or die "incompatible frameformat ($planes)\n";
  237.             ($width * $height * $depth) >> 3 == $image_size or die "strh(vids)/strf header format error\n";
  238.             
  239.             $image = new Image($width,$height,RGB);
  240.             $image->undo_disable;
  241.             $image->set_filename($filename);
  242.             $image->parasite_attach(new GimpParasite "gimp-interframe-delay", PARASITE_PERSISTENT, $us_frame);
  243.             $image->parasite_attach(new GimpParasite "gimp-avi-depth", PARASITE_PERSISTENT, $depth == 16 ? 15 : $depth);
  244.             $image->parasite_attach(new GimpParasite "gimp-avi-compression", PARASITE_PERSISTENT, $compression);
  245.          }
  246.       },
  247.       "00db" => sub {
  248.          $_[0] == ($width * $height * $depth) >> 3 or die "frame has incorrect size\n";
  249.          read FILE,$comment,$_[0];
  250.          my $layer = $image->layer_new($width,$height,RGB_IMAGE,
  251.                                        sprintf("(%.2fs)",$us_frame*$frame/1_000_000),
  252.                                        100,NORMAL_MODE);
  253.  
  254.          Gimp::RAW::convert_15_24_inplace $comment if $depth == 16;
  255.          Gimp::RAW::convert_bgr_rgb_inplace $comment if $depth == 24;
  256.          Gimp::RAW::reverse_v_inplace $comment,$width*3;
  257.          (new PixelRgn $layer,0,0,$width,$height,1,0)->set_rect2($comment,0,0);
  258.          $layer->add_layer(0);
  259.          $frame++;
  260.          update Progress $frame/$frames;
  261.       },
  262.       "00dc" => sub { die "compressed data not handled\n" },
  263.       "01wb" => \&skip_hunk,  # audio data
  264.       "idx1" => \&skip_hunk,  # hunk index
  265.       "ISFT" => \&skip_hunk,  # i? software?
  266.       "ICOP" => \&skip_hunk,  # i? copyright?
  267.       "IDIT" => \&skip_hunk,  # i? time stamp??
  268.       sub {
  269.          warn "skipping hunk (@_), please report!\n";
  270.          skip_hunk $_[1];
  271.       }
  272.    );
  273.  
  274.    $image->undo_enable;
  275.    return $image;
  276. };
  277.  
  278. Gimp::on_query {
  279.    Gimp->register_magic_load_handler("file_avi_load", "avi", "", "0,string,RIFF,&8,string,AVI ");
  280.    Gimp->register_save_handler("file_avi_save", "avi", "");
  281. };
  282.  
  283. exit main;
  284.  
  285.